home *** CD-ROM | disk | FTP | other *** search
/ PC Guide 18 / PC Guide CD-ROM (PCCD-18-12-96) (1996).iso / cylindrx / clock / iweb.wil < prev    next >
Text File  |  1996-08-29  |  5KB  |  185 lines
  1. ;******** Web client sample Winsock app ********
  2.  
  3. szTitle = "Charlie Cursor's Neat-O Web Browser"
  4. szDial = "%param1%"
  5. szHost = "%param2%"
  6. szPort = "80"
  7. hSock = 0
  8.  
  9. ;Dial our host...
  10. hConn = SDialUp (szDial)
  11. if (!hConn)
  12.     exit
  13. endif
  14.  
  15.  
  16. ; This is our "browser"...
  17. if (!WinExist (szTitle))
  18.     Run ("notepad.exe","%szTitle%.")
  19.     if (WinExistChild ("Notepad", "Cannot find the %szTitle%. file"))
  20.         SendKeysTo ("Notepad", "~")
  21.     endif
  22.     SendKeysTo (szTitle, "!ew") ; Turn on word-wrap
  23. else
  24.     ; Clear the existing browser window...
  25.     SendKeysTo (szTitle, "!ea{del}")
  26. endif
  27.  
  28.  
  29. ; Main command loop...
  30. szURL = "http://%szHost%/"
  31. szURLList = ""
  32. while (szURL<>"")
  33.     ; Get the URL...
  34.     szURLList = ItemInsert ("<end>", -1, szURLList, @TAB) 
  35.     szURLList = ItemInsert ("<new>", -1, szURLList, @TAB) 
  36.     szURL = AskItemList ("Choose the URL, <new>, or <end>:", szURLList, @TAB, @Unsorted, @Single)
  37.     if (szURL=="<end>" || szURL=="")
  38.         goto HangUp
  39.     endif
  40.     if (szURL=="<new>")
  41.         szURL = AskLine (szTitle, "Enter the URL:", szURL)
  42.     endif
  43.  
  44.     gosub SplitURL
  45.  
  46.     ; Clear our browser window...
  47.     SendKeysTo (szTitle, "!ea{del}")
  48.  
  49.     ; Create a socket...
  50.     hSock = SOpen (@SBlocking)
  51.     if (hSock==@SErrSocket)
  52.         Message (szTitle, "Couldn't create socket.")
  53.         goto HangUp
  54.     endif
  55.  
  56.     ; Connect it up...
  57.     nRet = SConnect (hSock, szHost, szPort)
  58.     if (nRet <> @TRUE)
  59.         nErr = SGetLastErr ()
  60.         Message (szTitle, "Error connecting socket to %szHost%:%szPort% %@CRLF%    %nErr%")
  61.         goto CloseSocket
  62.     endif
  63.  
  64.     ; Send our HTTP request...
  65.     szCmd = "GET %szFile% HTTP/1.0"
  66.     nRet = SSendLine (hSock, szCmd)
  67.     nRet = SSendLine (hSock, "") ; Blank line ends an HTTP request
  68.     if (nRet<>@SOK)
  69.         nErr = SGetLastErr()
  70.         Message (szTitle, "Error sending command: %nErr%")
  71.         goto CloseSocket
  72.     endif
  73.  
  74.     ; Get the HTTP headers...
  75.     szHeader = ""
  76.     szLine = SRecvLine (hSock, 32767)
  77.     nErr = SGetLastErr()
  78.     while (nErr<>@SErrNoConn)
  79.         if (nErr == @SOK)
  80.             szHeader = StrCat (szHeader, szLine, @CRLF)
  81.         endif
  82.         Yield ()
  83.         szLine = SRecvLine (hSock, 32767)
  84.         nErr = SGetLastErr()
  85.     endwhile
  86.  
  87.     ; Just for fun, display ea. header line in our browser window...
  88.     ClipPut (szHeader)
  89.     SendKeysTo (szTitle, "^v~")
  90.  
  91.     ; Get the actual data (many lines, but delim with single LF
  92.     ; so it's really all one big string)...
  93.     szPage = ""
  94.     while (nErr <> @SErrNoConn)
  95.         szLine = SRecvLine (hSock, 32767)
  96.         nErr = SGetLastErr ()
  97.         if (nErr == @SOK)
  98.             ; Now display it in our browser window...
  99.             szLine = strreplace (szLine, num2char(10), @CRLF)
  100.             if (strright(szPage,2) <> @CRLF)
  101.                 szLine = StrCat (szLine, @CRLF)
  102.             endif
  103.             szPage = StrCat (szPage, szLine)
  104.         endif
  105.         Yield ()
  106.     endwhile
  107.  
  108.     ; Extract the links from this page...
  109.     gosub ParsePage
  110.  
  111.     ClipPut (szPage)
  112.     SendKeysTo (szTitle, "^v~")
  113.  
  114.     ; Close the socket...
  115.     :Cancel
  116.     :CloseSocket
  117.     if (hSock <> 0)
  118.         nRet = SClose (hSock)
  119.     endif
  120. endwhile
  121.  
  122.  
  123. ; Hang up...
  124. :HangUp
  125. nRet = SHangUp (hConn)
  126. exit
  127.  
  128.  
  129. ;**************************************************************************
  130. ; Split up szURL into szHost & szFile.
  131. ;**************************************************************************
  132. :SplitURL
  133. nSUStart = 1
  134. if (strindex (szURL, "http://", 1, @FWDSCAN) == 1)
  135.     nSUStart = 8
  136. endif
  137.  
  138. nSUSlash = strindex (szURL, "/", nSUStart, @FWDSCAN)
  139. if (nSUSlash == 0)
  140.     szURL = strcat (szURL, "/")
  141.     nSUSlash = strlen(szURL)
  142. endif
  143.  
  144. if (nSUSlash <> 1)
  145.     szHost = strsub (szURL, nSUStart, nSUSlash-nSUStart)
  146. endif
  147. szFile = strsub (szURL, nSUSlash, strlen(szURL)-nSUSlash+1)
  148.  
  149. return
  150.  
  151.  
  152. ;**************************************************************************
  153. ; Extract all the hyperlinks from szPage into szURLList.
  154. ;**************************************************************************
  155. :ParsePage
  156. nPPH = 1
  157. nPPQ2 = 1
  158. szURLList = ""
  159.  
  160. nPPLen = StrLen(szPage)
  161. Message (szTitle, "szPage is %nPPLen% chars long.")
  162. if (nPPLen < 5)
  163.     return
  164. endif
  165.  
  166. while (nPPQ2 > 0)
  167.     nPPH = StrIndex (szPage, "HREF=", nPPQ2, @FWDSCAN)
  168.     if (nPPH > 0)
  169.         Message (szTitle, "HREF= found at %nPPH%")
  170.         nPPQ1 = StrIndex (szPage, '"', nPPH+5,  @FWDSCAN)
  171.         if (nPPQ1 > 0)
  172.             Message (szTitle, '1st " found at %nPPQ1%')
  173.             nPPQ2 = StrIndex (szPage, '"', nPPQ1+1, @FWDSCAN)
  174.             if (nPPQ2 > 0)
  175.                 Message (szTitle, '2nd " found at %nPPQ2%')
  176.                 szPPURL = StrSub (szPage, nPPQ1+1, nPPQ2-nPPQ1-1)
  177.                 Message (szTitle, "szPPURL = %szPPURL%")
  178.                 szURLList = ItemInsert (szPPURL, -1, szURLList, @TAB)
  179.             endif
  180.         endif
  181.     endif
  182. endwhile
  183.  
  184. return
  185.